home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1996 #15
/
Monster Media Number 15 (Monster Media)(July 1996).ISO
/
tbbs
/
tigerfix.zip
/
WTCHNEWS.PRG
< prev
next >
Wrap
Text File
|
1996-05-22
|
30KB
|
777 lines
*--------------------------------------------------------------------------*
*--------------------------------------------------------------------------*
* *
* PRUNEIN *
* *
* (c) 1993 by Bernal Schooley *
* and Advanced Designs *
* *
* This program is being released as SHAREware! Please REGISTER it if *
* you decide to use it in ANY way. A LOT of work has gone into this *
* and is available to you now because OTHER people have SUPPORTED the *
* development of this and other TDBS software by Advanced Designs. *
* *
* I ask YOU to be among those who support this and future developments *
* by REGISTERING PRUNE. Registration is ONLY $25.00 and will allow *
* you to recieve technical support and will give you a feeling of *
* satisfaction in knowing that your supporting the efforts of a *
* struggling third party TDBS developer. ;) *
* *
* Thank you! *
* --Bernal Schooley *
* Advanced Designs *
* 217-344-9145 (voice) *
* 217-367-1710 (support bbs) *
* bernal@unity.com (internet) *
* *
*--------------------------------------------------------------------------*
*--------------------------------------------------------------------------*
* *
* If you need additional function added to this program and are unable, *
* or simply don't have enough time, to do it yourself, you may call *
* Bernal Schooley for a quote on custom programming services! Average *
* hourly rates for short to medium term contracts are $40.00. This amount *
* can vary based on complexity, onsite or offsite, and length of overall *
* contract. *
* *
*--------------------------------------------------------------------------*
*--------------------------------------------------------------------------*
CLEAR
** Load path variables from the TIGER.CTL file
FOPEN handle "\TBBS\TIGER.CTL" 10 FMAXLEN()
FLFIND handle pos "UUCPIN:" 1
FLREAD handle bytes data
uucpin = UPPER(LTRIM(RTRIM(CRTRIM(SUBSTR(data,AT("UUCPIN:",UPPER(data))+8)))))
FSEEK handle pos 0 0
FLFIND handle pos "UUCPIN-STAGE:" 1
FLREAD handle bytes data
stagein = UPPER(LTRIM(RTRIM(CRTRIM(SUBSTR(data,AT("UUCPIN-STAGE:",UPPER(data))+14)))))
FSEEK handle pos 0 0
FLFIND handle pos "HOST:" 1
FLREAD handle bytes data
host = UPPER(LTRIM(RTRIM(CRTRIM(SUBSTR(data,AT("HOST:",UPPER(data))+6)))))
FSEEK handle pos 0 0
FLFIND handle pos "UUCPNAME:" 1
FLREAD handle bytes data
uucpname = UPPER(LTRIM(RTRIM(CRTRIM(SUBSTR(data,AT("UUCPNAME:",UPPER(data))+10)))))
FCLOSE handle
** Check for TIGRBUSY or MAILBUSY flags
DO WHILE .T.
IF FILE(stagein+"TIGRBUSY") .OR. FILE(uucpin+"TIGRBUSY")
CLEAR
? "Directories in use..."
? "PRUNEOUT waiting on TIGRBUSY flags..."
ELSE
IF FILE(stagein+"MAILBUSY") .OR. FILE(uucpin+"MAILBUSY")
CLEAR
? "Directories in use..."
? "PRUNEOUT waiting on MAILBUSY flags..."
ELSE
EXIT
ENDIF
ENDIF
?
? "(Press [A] to abort or [D] to delete busy flags and begin.)"
char = INKEY(10)
IF char = 65 .OR. char = 97
QUIT
ENDIF
IF char = 68 .OR. char = 100
IF FILE(stagein+"TIGRBUSY")
temp = stagein + "TIGRBUSY"
ERASE &temp
ENDIF
IF FILE(uucpin+"TIGRBUSY")
temp = uucpin + "TIGRBUSY"
ERASE &temp
ENDIF
IF FILE(stagein+"MAILBUSY")
temp = stagein + "MAILBUSY"
ERASE &temp
ENDIF
IF FILE(uucpin+"MAILBUSY")
temp = uucpin + "MAILBUSY"
ERASE &temp
ENDIF
EXIT
ENDIF
ENDDO
** All clear... write busy files to lock directories and begin
? "PRUNEIN - Working..."
in_busy = uucpin+"MAILBUSY"
out_busy = stagein+"MAILBUSY"
FCREATE handle &in_busy 3
FCLOSE handle
FCREATE handle &out_busy 3
FCLOSE handle
** Load "keep" array from PRUNE.CFG for use while pruning
max = 20
PUBLIC keep[max]
keep[1] = "From:"
keep[2] = "Reply-To:"
keep[3] = "Subject:"
FOPEN handle PRUNE.CFG 10 FMAXLEN()
FLFIND handle pos "PRUNE-METHOD:" 1
FLREAD handle bytes data
method = UPPER(LTRIM(RTRIM(CRTRIM(SUBSTR(data,AT("PRUNE-METHOD:",UPPER(data))+14)))))
FSEEK handle pos 0 0
FLFIND handle pos "ACCOUNTING:" 1
FLREAD handle bytes data
accounting = UPPER(LTRIM(RTRIM(CRTRIM(SUBSTR(data,AT("ACCOUNTING:",UPPER(data))+12)))))
** More variables could be loaded from the CFG file by adding code like
** the following:
*
* FSEEK handle pos 0 0
* FLFIND handle pos "[another keyword]:" 1
* FLREAD handle bytes data
* [new variable] = UPPER(LTRIM(RTRIM(CRTRIM(SUBSTR(data,AT("[keyword as above]:",UPPER(data))+14)))))
FSEEK handle pos 0 0
FLFIND handle pos "KEEP:" 1
FLREAD handle bytes data
FLREAD handle bytes data
top = 3
DO WHILE data # "ENDKEEP:" .AND. bytes > 0 .AND. top < max
top = top + 1
keep[top] = LTRIM(RTRIM(CRTRIM(data)))
FLREAD handle bytes data
ENDDO
FCLOSE handle
** Perform pruning on all .D files in the stagein directory
xfile = FINDFIRST(fnd_nxt, stagein+"*.X")
xfilep = stagein+xfile
DO WHILE LEN(xfile) > 0
** open the .X file
FOPEN handle &xfilep 10 FMAXLEN()/2
** Read "F" line to find the file name
FLFIND handle pos "F "
IF pos < 1
FCLOSE handle
tofile = STUFF(xfilep,AT(".X",xfilep),2,".X!!")
RENAME &xfilep TO &tofile
xfile = FINDNEXT(fnd_nxt)
xfilep = stagein+xfile
LOOP
ENDIF
FLREAD handle bytes data
data = RTRIM(CRTRIM(data))
IF LEN(data) < 6 .OR. .NOT. "D." $ UPPER(data)
FCLOSE handle
tofile = STUFF(xfilep,AT(".X",xfilep),2,".X!!")
RENAME &xfilep TO &tofile
xfile = FINDNEXT(fnd_nxt)
xfilep = stagein+xfile
LOOP
ENDIF
** calculate the .D file name
dfile = RTRIM(CRTRIM(SUBSTR(data,AT("D.",UPPER(data))+2)))
** Calculate the first letter of a .D waffle file *******
y = 1
tryhost = .T.
tryuucp = .T.
lenh = LEN(host)
lenu = LEN(uucpname)
DO WHILE y > 0
IF y <= lenh .AND. tryhost
IF UPPER(LEFT(dfile,1)) = SUBSTR(host,y,1)
dfile = SUBSTR(dfile,2)
y = y + 1
LOOP
ELSE
IF tryuucp
tryhost = .F.
ELSE
exit
ENDIF
ENDIF
ELSE
tryhost = .F.
IF .NOT. tryuucp
exit
ENDIF
ENDIF
IF y <= lenu .AND. tryuucp
IF UPPER(LEFT(dfile,1)) = SUBSTR(uucpname,y,1)
dfile = SUBSTR(dfile,2)
y = y + 1
LOOP
ELSE
IF tryhost
tryuucp = .F.
ELSE
exit
ENDIF
ENDIF
ELSE
tryuucp = .F.
IF .NOT. tryhost
exit
ENDIF
ENDIF
ENDDO
DO WHILE "." $ dfile
dfile = STUFF(dfile,AT(".",dfile),1,"")
ENDDO
x = LEN(dfile)
y = 1
char_val = 0
DO WHILE y <= 16 .AND. x > 0
IF ISLOWER(SUBSTR(dfile,x,1))
char_val = char_val + y
ENDIF
y = y * 2
x = x - 1
ENDDO
IF char_val < 10
dfile = CHR(char_val+48)+dfile+".D"
ELSE
dfile = CHR(char_val+55)+dfile+".D"
ENDIF
** End of calculation - dfile now has the correct name (hopefully)
** verify existance of .D file
dfilep = stagein+dfile
IF .NOT. FILE(dfilep)
FCLOSE handle
tofile = STUFF(xfilep,AT(".X",xfilep),2,".X!!")
RENAME &xfilep TO &tofile
xfile = FINDNEXT(fnd_nxt)
xfilep = stagein+xfile
LOOP
ENDIF
IF accounting = "YES"
** load in the "C" line from the .X file
FSEEK handle pos 0 0
FLFIND handle pos "C "
IF pos < 1 .OR. FSIZE(dfilep) = 0
FCLOSE handle
tofile = STUFF(xfilep,AT(".X",xfilep),2,".X!!")
RENAME &xfilep TO &tofile
tofile = STUFF(dfilep,AT(".D",xfilep),2,".D!!")
RENAME &xfilep TO &tofile
xfile = FINDNEXT(fnd_nxt)
xfilep = stagein+xfile
LOOP
ENDIF
FLREAD handle bytes data
** Check to see if it is mail
IF "RMAIL" $ UPPER(data)
data = UPPER(RTRIM(LTRIM(CRTRIM(SUBSTR(data,9)))))
** Loop if more than one name is in the RMAIL line
DO WHILE LEN(data) > 0
** strip out the name from the rmail line
IF " " $ data .OR. "@" $ data
IF "@" $ data
name = SUBSTR(data,1,AT("@",data)-1)
IF " " $ data
data = SUBSTR(data,AT(" ",data)+1)
ENDIF
ELSE
name = SUBSTR(data,1,AT(" ",data)-1)
data = SUBSTR(data,AT(" ",data)+1)
ENDIF
ELSE
name = data
data = ""
ENDIF
IF "!" $ name
name = SUBSTR(name,RAT("!",name)+1)
ENDIF
DO WHILE "." $ name
name = STUFF(name,AT(".",name),1," ")
ENDDO
*---------------------------------------------------------*
* *
* This is where you would add code if you want to perform *
* accounting functions. At this point the field "name" *
* contains the name of the user on your system that this *
* message is for. You could at this time store that and *
* after looking up the size of dfilep and xfilep store *
* that as well. You would need to put these in a *
* database because you can not access the users userlog *
* record at this time. You could create a program that *
* is autoexecuted at logon which would lookup any new *
* accounting data records and adjust the users netmail *
* at that time. *
* *
* PS: There is code here that will attempt to grab each *
* name in the actual "C" line. There may be more than *
* one in the case of mailing lists for instance. This *
* code is not fully tested for such senarios and would *
* need to have a full set of test performed after you add *
* code and turn on the accounting features. *
* *
*---------------------------------------------------------*
ENDDO
ENDIF
ENDIF
** Close the .X file
FCLOSE handle
** Prepair to process the .D file and rename to show current file
** being processed.
dback = SUBSTR(dfile,1,AT(".",dfile))+"D##"
dbackp = stagein+dback
** Rename .d file to .d## and create new .d file of same name
RENAME &dfilep TO &dbackp
dfilep = uucpin+dfile
FOPEN handle &dbackp 10 FMAXLEN()/3
FLREAD handle bytes data
FCREATE newhandle &dfilep 13 0 FMAXLEN()/2
** Skip the first line if it is a cunbatch line sometimes sent
** even on uncompress news files
IF UPPER(LEFT(data,3)) = "CUN"
FLREAD handle bytes data
ENDIF
** If this is a news file the line will have the rnews line in it
IF UPPER(LEFT(data,8)) # "#! RNEWS"
** Mail file processing
? "MAIL: "+dfile
header = .T.
DO WHILE bytes > 0
** for speed keep track of when the header is being processed
IF header .AND. LEN(RTRIM(CRTRIM(data))) > 0
** Header lines will always begin with a header field
** name or with a white space character of space or tab.
** White space lines we'll have to handle them the same
** as was done on the previous field line.
IF data = " " .OR. data = CHR(9)
IF lastprune
** If method is HIDE, write the line with a CHR(1)
** preceeding it. TBBS will then hide the lines
** from display except in the Quoting function.
IF method = "HIDE"
FLWRITE newhandle out CHR(1)
FLWRITE newhandle out data
ENDIF
ELSE
FLWRITE newhandle out data
ENDIF
ELSE
*---------------------------------------------------------*
* *
* This is where you would add code if you want to look *
* for information in the mail headers. Each pass through *
* here has a line of the header in the "data" field. *
* *
* For example you could have: *
* *
* IF data = "To:" .AND. "FTPMAIL" $ data *
* datarequest = .T. *
* ENDIF *
* *
*---------------------------------------------------------*
** For error recovery make sure this file has not been
** processed before, but do the whole thing anyway to
** make sure everything is marked properly.
IF data # CHR(1)
** if this is a header field line then strip the field
** name off and look it up in the keep array. If found
** write it out as normal, otherwise prune it.
temp = SUBSTR(data,1,AT(":",data))
IF ASCAN(keep,temp) # 0
FLWRITE newhandle out data
lastprune = .F.
ELSE
IF method = "HIDE"
FLWRITE newhandle out CHR(1)
FLWRITE newhandle out data
ENDIF
lastprune = .T.
ENDIF
ELSE
FLWRITE newhandle out data
ENDIF
ENDIF
ELSE
*---------------------------------------------------------*
* *
* This is where you would add code if you want to look *
* for information in the body of a mail message. On each *
* pass "data" has one line of the message body. *
* *
* For example you could have: *
* *
* IF datarequest .AND. "SEND INDEX" $ data *
* FLWRITE newhandle out "GET INDEX.LST"+CHR(10) *
* ENDIF *
* *
*---------------------------------------------------------*
FLWRITE newhandle out data
header = .F.
ENDIF
FLREAD handle bytes data
ENDDO
ELSE
** News file processing
? "NEWS: "+dfile
DO WHILE bytes > 0
** To process news files a temporary file must be used in order
** to determine the full size of the news message before writing
** the first line of the .D news message header.
** Each news message must be temporarily written to this temp
** file then once the full size is determined and the header
** line is written to the .d then the temp file may be copied
** back to the new .d file.
FCREATE temphandle PRUNE.$$$ 13 0 FMAXLEN()
header = .T.
FLREAD handle bytes data
DO WHILE data # "#! rnews" .AND. bytes > 0
** for speed keep track of when the header is being processed
IF header .AND. LEN(RTRIM(CRTRIM(data))) > 0
** Header lines will always begin with a header field
** name or with a white space character of space or tab.
** White space lines we'll have to handle them the same
** as was done on the previous field line.
IF data = " " .OR. data = CHR(9)
IF lastprune
** If method is HIDE, write the line with a CHR(1)
** preceeding it. TBBS will then hide the lines
** from display except in the Quoting function.
IF method = "HIDE"
FLWRITE temphandle out CHR(1)
FLWRITE temphandle out data
ENDIF
ELSE
FLWRITE temphandle out data
ENDIF
ELSE
** For error recovery make sure this file has not been
** processed before, but do the whole thing anyway to
** make sure everything is marked properly.
IF data # CHR(1)
** if this is a header field line then strip the field
** name off and look it up in the keep array. If found
** write it out as normal, otherwise prune it.
temp = SUBSTR(data,1,AT(":",data))
IF ASCAN(keep,temp) # 0
FLWRITE temphandle out data
lastprune = .F.
ELSE
IF method = "HIDE"
FLWRITE temphandle out CHR(1)
FLWRITE temphandle out data
ENDIF
lastprune = .T.
ENDIF
ELSE
FLWRITE temphandle out data
ENDIF
ENDIF
ELSE
FLWRITE temphandle out data
header = .F.
ENDIF
FLREAD handle bytes data
ENDDO
** This is where the news header line is written with the size
** of the new message, then the temp file is copied into the
** new .d file.
?? "."
FCLOSE temphandle
FLWRITE newhandle out "#! rnews "+LTRIM(STR(FSIZE("PRUNE.$$$")))+CHR(10)
FOPEN temphandle PRUNE.$$$ 10 FMAXLEN()
FLREAD temphandle in data
DO WHILE in > 0
FLWRITE newhandle out data
FLREAD temphandle in data
ENDDO
FCLOSE temphandle
ENDDO
ENDIF
** Close and move .X file
ERASE PRUNE.$$$
FCLOSE handle
FCLOSE newhandle
ERASE &dbackp
tofile = uucpin+xfile
COPY FILE &xfilep TO &tofile
ERASE &xfilep
** Get next .X file
xfile = FINDNEXT(fnd_nxt)
xfilep = stagein+xfile
ENDDO
** Remove busy flags
ERASE &in_busy
ERASE &out_busy
*--------------------------------------------------------------------------*
*--------------------------------------------------------------------------*
* *
* WARRANTY / DISCLAIMER: PRUNE IS DISTRIBUTED ON AN "AS IS" BASIS ONLY, *
* WITHOUT WARRANTY. NEITHER ADVANCED DESIGNS, NOR BERNAL SCHOOLEY, SHALL *
* HAVE LIABILITY OR RESPONSIBILITY TO ANY PERSON OR ENTITY WITH RESPECT *
* TO LIABILITY, LOSS, OR DAMAGE CAUSED OR ALLEGED TO BE CAUSED BY THIS *
* SOFTWARE. THIS INCLUDES, BUT IS NOT LIMITED TO, ANY INTERRUPTION OF *
* SERVICE, LOSS OF BUSINESS OR ANTICIPATORY PROFITS, OR CONSEQUENTIAL *
* DAMAGE RESULTING FROM THE USE OF THIS SOFTWARE. *
* *
*--------------------------------------------------------------------------*
*--------------------------------------------------------------------------*
************************WTCHNEWS.PRG (c) David Rance*************************
* Source released to the Public Domain *
* *
* A quick 'n' dirty program for Rick Sande (and others) to check incoming *
* .D files for over-long newsgroup lines and to delete the file if too *
* long. *
* 1st May, 1996 - Version 0.2. First version deleted the whole packet if *
* only one message was bad! Rectified. *
public tigerpath
tigerpath=""
? "WatchNews ver. 0.2 - checks incoming .D files for over-long newsgroup lines"
? "(c) 1996 David Rance"
?
SET ALTERNATE TO c:\tbbs\news.log APPEND
set alternate on
ctime=time()
cdate=dtoc(date())
?
? "Processing Started: "+ctime+" "+cdate
do get_config && process config file
* Check for TIGER, quit if active, create MAILBUSY if not (this is in case
* the program is used from a menu entry).
fopen handle1 (tigerpath+"tigrbusy") 0
if handle1 < 0 && if TIGRBUSY doesn't exist create MAILBUSY
fcreate handle1 (tigerpath+"mailbusy") 13
fclose handle1
else
? "TIGER is active. Aborting"
dummy=inkey(2)
? "Finished!"
quit
endif
fname=findfirst(dta,tigerpath+"*.d") && Search inbound for .D files
if len(fname)=0
? "No files found to process"
? "Finished!"
dummy=inkey(2)
erase (tigerpath+"mailbusy")
quit
endif
do while len(fname)#0
do proc_file
fname=findnext(dta)
enddo
? "Finished!"
?
dummy=inkey(2)
erase (tigerpath+"mailbusy")
**** END MAIN ****
PROCEDURE proc_file
c=0
? "Processing "+fname && Open .D file
fname=substr(fname,1,at(".",fname)-1)+".D"
fopen handle1 (tigerpath+fname) 10 1024
if handle1 < 0 && Loop back if it can't be opened
?? " - can't be opened. Continuing..."
return
endif
flread handle1 size record
if at("#! rnews",record)#1 && If not "#! rnews" it's not
?? " - is not news" && a news message so exit
fclose handle1
return
endif
fcreate handle2 TEMPFILE.$$$ 13 && create temp. buffer file
destname=substr(fname,1,at(".",fname))+"$$$" && create temporary output file
fcreate handle3 (tigerpath+destname) 13
flwrite handle2 wsize record && write first "#! rnews" line
flread handle1 size record
do while size > 0 && do loop until end of file
if at("Newsgroups:",record)=1 && if Newsgroups line....
if size > 250 && if greater than 250 bytes....
? "Message deleted"
SET ALTERNATE TO c:\tbbs\newsfix\fix.log
set alternate on
c=1 && set flag
endif
endif
if at("#! rnews",record)=1 && if start of new message....
if c#1 && if flag not set ...
fclose handle2
fopen handle2 TEMPFILE.$$$ 10
do while size > 0 && ... copy tempfile to dest file
flread handle2 size newrecord
flwrite handle3 size newrecord
enddo
endif
fclose handle2
erase handle2
fcreate handle2 TEMPFILE.$$$ 13
c=0
endif
flwrite handle2 wsize record
flread handle1 size record
enddo
fclose handle1
fclose handle2
if c#1 && if flag not set
fopen handle2 TEMPFILE.$$$ 10
flread handle2 size newrecord
do while size > 0 && and copy tempfile to dest file
flwrite handle3 wsize newrecord
flread handle2 size newrecord
enddo
fclose handle2
erase handle2
endif
fclose handle3
erase (tigerpath+fname)
copy file (tigerpath+destname) to (tigerpath+fname)
erase (tigerpath+destname)
erase "TEMPFILE.$$$"
return
**** END Procedure proc_file ****
PROCEDURE get_config
fopen handle1 wtchnews.cfg 10 128 && open config file
if handle1 < 0
? "Couldn't find configuration file. Aborting."
dummy=inkey(2)
quit
endif
flread handle1 size record && this bit taken from another program
do while size#0 && so left "do case" in even though there's
do case && only one option!
case at("TIGERFILES",record)=1
tigerpath=ltrim(rtrim(crtrim(substr(record,11))))
if right(tigerpath,1)#"\"
tigerpath=tigerpath+"\"
endif
endcase
flread handle1 size record
enddo
* Check that all necessary variables are initialised. Abort if any are missing.
missing=""
do case
case len(tigerpath)=0
missing="TIGER inbound path"
endcase
if len(missing)#0
? missing+" is not defined. Aborting."
dummy=inkey(2)
? "Finished!"
quit
endif
fclose handle1 && close the config file
return
**** END procedure get_config ****
****************************** END OF PROGRAM ********************************
set alternate on
